home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 May: Tool Chest / Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso / Tool Chest / Development Tools & Languages / Dylan Related / Mindy / Mindy 1.2 - portable sources / comp / dump.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-03-15  |  25.4 KB  |  1,150 lines  |  [TEXT/ttxt]
  1. /**********************************************************************\
  2. *
  3. *  Copyright (c) 1994  Carnegie Mellon University
  4. *  All rights reserved.
  5. *  
  6. *  Use and copying of this software and preparation of derivative
  7. *  works based on this software are permitted, including commercial
  8. *  use, provided that the following conditions are observed:
  9. *  
  10. *  1. This copyright notice must be retained in full on any copies
  11. *     and on appropriate parts of any derivative works.
  12. *  2. Documentation (paper or online) accompanying any system that
  13. *     incorporates this software, or any part of it, must acknowledge
  14. *     the contribution of the Gwydion Project at Carnegie Mellon
  15. *     University.
  16. *  
  17. *  This software is made available "as is".  Neither the authors nor
  18. *  Carnegie Mellon University make any warranty about the software,
  19. *  its performance, or its conformity to any specification.
  20. *  
  21. *  Bug reports, questions, comments, and suggestions should be sent by
  22. *  E-mail to the Internet address "gwydion-bugs@cs.cmu.edu".
  23. *
  24. ***********************************************************************
  25. *
  26. * $Header: dump.c,v 1.21 94/11/28 07:56:04 wlott Exp $
  27. *
  28. * This file dumps the results of the compilation into a .dbc file.
  29. *
  30. \**********************************************************************/
  31.  
  32. #include "../compat/std-c.h"
  33. #include "../compat/std-os.h"
  34.  
  35. #include "mindycomp.h"
  36. #include "src.h"
  37. #include "literal.h"
  38. #include "sym.h"
  39. #include "fileops.h"
  40. #include "compile.h"
  41. #include "dump.h"
  42. #include "version.h"
  43. #include "envanal.h"
  44. #include "lose.h"
  45.  
  46. static FILE *File = NULL;
  47. static int table_index = 0;
  48. static boolean ModuleDumped = FALSE;
  49.  
  50. static void dump_literal(struct literal *literal);
  51. static void dump_constant(struct constant *c);
  52. static void dump_constant(struct constant *c);
  53.  
  54.  
  55. /* Base output routines */
  56.  
  57. inline static void dump_byte(unsigned byte)
  58. {
  59.     putc(byte, File);
  60. }
  61.  
  62. #define dump_op dump_byte
  63.  
  64. inline static void dump_bytes(void *ptr, int bytes)
  65. {
  66.     int count;
  67.  
  68.     while (bytes > 0) {
  69.     count = fwrite(ptr, 1, bytes, File);
  70.     ptr = (char *)ptr + count;
  71.     bytes -= count;
  72.     }
  73. }
  74.  
  75. inline static void dump_short(short value)
  76. {
  77.     dump_bytes(&value, sizeof(value));
  78. }
  79.  
  80. inline static void dump_int(int value)
  81. {
  82.     dump_bytes(&value, sizeof(value));
  83. }
  84.  
  85. inline static void dump_long(long value)
  86. {
  87.     dump_bytes(&value, sizeof(value));
  88. }
  89.  
  90.  
  91. /* Table manipulation */
  92.  
  93. static int implicit_store(void)
  94. {
  95.     return table_index++;
  96. }
  97.  
  98. static int dump_store(void)
  99. {
  100.     dump_op(fop_STORE);
  101.     return table_index++;
  102. }
  103.  
  104. static void dump_ref(int handle)
  105. {
  106.     if (handle <= USHRT_MAX) {
  107.     dump_op(fop_SHORT_REF);
  108.     dump_short(handle);
  109.     }
  110.     else {
  111.     dump_op(fop_REF);
  112.     dump_int(handle);
  113.     }
  114. }
  115.  
  116.  
  117. /* Utility dumpers. */
  118.  
  119. static void dump_string_guts(int short_op, int long_op, char *str, int length)
  120. {
  121.     if (length < 256) {
  122.     dump_op(short_op);
  123.     dump_byte(length);
  124.     }
  125.     else {
  126.     dump_op(long_op);
  127.     dump_int(length);
  128.     }
  129.     dump_bytes(str, length);
  130. }
  131.  
  132. static void dump_integer(long value)
  133. {
  134.     if (SCHAR_MIN <= value && value <= SCHAR_MAX) {
  135.     dump_op(fop_SIGNED_BYTE);
  136.     dump_byte(value);
  137.     }
  138.     else if (SHRT_MIN <= value && value <= SHRT_MAX) {
  139.     dump_op(fop_SIGNED_SHORT);
  140.     dump_short(value);
  141.     }
  142.     else if (INT_MIN <= value && value <= INT_MAX) {
  143.     dump_op(fop_SIGNED_INT);
  144.     dump_int(value);
  145.     }
  146.     else {
  147.     dump_op(fop_SIGNED_LONG);
  148.     dump_long(value);
  149.     }
  150. }
  151.  
  152. static void dump_symbol(struct symbol *symbol)
  153. {
  154.     if (symbol->handle != -1)
  155.     dump_ref(symbol->handle);
  156.     else {
  157.     symbol->handle = implicit_store();
  158.     dump_string_guts(fop_SHORT_SYMBOL, fop_SYMBOL, (char *)symbol->name,
  159.              strlen((char *)symbol->name));
  160.     }
  161. }
  162.  
  163.  
  164. /* Literal dumping. */
  165.  
  166. static void dump_symbol_literal(struct symbol_literal *literal)
  167. {
  168.     dump_symbol(literal->symbol);
  169. }
  170.  
  171. static void dump_integer_literal(struct integer_literal *literal)
  172. {
  173.     dump_integer(literal->value);
  174. }
  175.  
  176. static void dump_single_float_literal(struct single_float_literal *literal)
  177. {
  178.     dump_op(fop_SINGLE_FLOAT);
  179.     dump_bytes(&literal->value, sizeof(literal->value));
  180. }
  181.  
  182. static void dump_double_float_literal(struct double_float_literal *literal)
  183. {
  184.     dump_op(fop_DOUBLE_FLOAT);
  185.     dump_bytes(&literal->value, sizeof(literal->value));
  186. }
  187.  
  188. static void dump_extended_float_literal(struct extended_float_literal *literal)
  189. {
  190.     dump_op(fop_EXTENDED_FLOAT);
  191.     dump_bytes(&literal->value, sizeof(literal->value));
  192. }
  193.  
  194. static void dump_character_literal(struct character_literal *literal)
  195. {
  196.     dump_op(fop_CHAR);
  197.     dump_byte(literal->value);
  198. }
  199.  
  200. static void dump_string_literal(struct string_literal *literal)
  201. {
  202.     dump_string_guts(fop_SHORT_STRING, fop_STRING, (char *)literal->chars,
  203.              literal->length);
  204. }
  205.  
  206. static void dump_list_literal(struct list_literal *literal)
  207. {
  208.     struct literal *part;
  209.     int length;
  210.     int i;
  211.  
  212.     length = 0;
  213.     for (part = literal->first; part != NULL; part = part->next)
  214.     length++;
  215.  
  216.     part = literal->first;
  217.     while (length > 255+9) {
  218.     dump_op(fop_DOTTED_LISTN);
  219.     dump_byte(255);
  220.     for (i = 0; i < 255+9; i++) {
  221.         dump_literal(part);
  222.         part = part->next;
  223.     }
  224.     length -= 255+9;
  225.     }
  226.  
  227.     if (literal->tail)
  228.     switch (length) {
  229.       case 0: lose("Zero element dotted list?\n");
  230.       case 1: dump_op(fop_DOTTED_LIST1); break;
  231.       case 2: dump_op(fop_DOTTED_LIST2); break;
  232.       case 3: dump_op(fop_DOTTED_LIST3); break;
  233.       case 4: dump_op(fop_DOTTED_LIST4); break;
  234.       case 5: dump_op(fop_DOTTED_LIST5); break;
  235.       case 6: dump_op(fop_DOTTED_LIST6); break;
  236.       case 7: dump_op(fop_DOTTED_LIST7); break;
  237.       case 8: dump_op(fop_DOTTED_LIST8); break;
  238.       default:
  239.         dump_op(fop_DOTTED_LISTN);
  240.         dump_byte(length - 9);
  241.         break;
  242.     }
  243.     else
  244.     switch (length) {
  245.       case 0: dump_op(fop_NIL); break;
  246.       case 1: dump_op(fop_LIST1); break;
  247.       case 2: dump_op(fop_LIST2); break;
  248.       case 3: dump_op(fop_LIST3); break;
  249.       case 4: dump_op(fop_LIST4); break;
  250.       case 5: dump_op(fop_LIST5); break;
  251.       case 6: dump_op(fop_LIST6); break;
  252.       case 7: dump_op(fop_LIST7); break;
  253.       case 8: dump_op(fop_LIST8); break;
  254.       default:
  255.         dump_op(fop_LISTN);
  256.         dump_byte(length - 9);
  257.         break;
  258.     }
  259.     while (part != NULL) {
  260.     dump_literal(part);
  261.     part = part->next;
  262.     }
  263.     if (literal->tail)
  264.     dump_literal(literal->tail);
  265. }
  266.  
  267. static void dump_vector_header(int length)
  268. {
  269.     switch (length) {
  270.       case 0: dump_op(fop_VECTOR0); break;
  271.       case 1: dump_op(fop_VECTOR1); break;
  272.       case 2: dump_op(fop_VECTOR2); break;
  273.       case 3: dump_op(fop_VECTOR3); break;
  274.       case 4: dump_op(fop_VECTOR4); break;
  275.       case 5: dump_op(fop_VECTOR5); break;
  276.       case 6: dump_op(fop_VECTOR6); break;
  277.       case 7: dump_op(fop_VECTOR7); break;
  278.       case 8: dump_op(fop_VECTOR8); break;
  279.       default:
  280.     dump_op(fop_VECTORN);
  281.     if (length-9 < 254)
  282.         dump_byte(length-9);
  283.     else if (length-9-254 <= USHRT_MAX) {
  284.         dump_byte(254);
  285.         dump_short(length-9-254);
  286.     }
  287.     else {
  288.         dump_byte(255);
  289.         dump_int(length-9-254-USHRT_MAX-1);
  290.     }
  291.     break;
  292.     }
  293. }
  294.  
  295. static void dump_vector_literal(struct vector_literal *literal)
  296. {
  297.     struct literal *part;
  298.     int length;
  299.  
  300.     length = 0;
  301.     for (part = literal->first; part != NULL; part = part->next)
  302.     length++;
  303.  
  304.     dump_vector_header(length);
  305.  
  306.     for (part = literal->first; part != NULL; part = part->next)
  307.     dump_literal(part);
  308. }
  309.  
  310. static void dump_true_literal(struct literal *literal)
  311. {
  312.     dump_op(fop_TRUE);
  313. }
  314.  
  315. static void dump_false_literal(struct literal *literal)
  316. {
  317.     dump_op(fop_FALSE);
  318. }
  319.  
  320. static void dump_unbound_literal(struct literal *literal)
  321. {
  322.     dump_op(fop_UNBOUND);
  323. }
  324.  
  325. static void (*LiteralDumpers[(int)literal_Kinds])() = {
  326.     dump_symbol_literal, dump_integer_literal,
  327.     dump_single_float_literal, dump_double_float_literal,
  328.     dump_extended_float_literal, dump_character_literal, dump_string_literal,
  329.     dump_list_literal, dump_vector_literal, dump_true_literal,
  330.     dump_false_literal, dump_unbound_literal
  331. };
  332.  
  333. static void dump_literal(struct literal *literal)
  334. {
  335.     (LiteralDumpers[(int)literal->kind])(literal);
  336. }
  337.  
  338.  
  339.  
  340. /* Debug info dumping. */
  341.  
  342. static void dump_vars(struct scope_info *scope)
  343. {
  344.     struct var_info *var_info;
  345.  
  346.     if (scope->handle != -1)
  347.     dump_ref(scope->handle);
  348.     else {
  349.     scope->handle = dump_store();
  350.  
  351.     if (scope->outer)
  352.         dump_op(fop_DOTTED_LIST1);
  353.     else
  354.         dump_op(fop_LIST1);
  355.  
  356.     dump_vector_header(scope->nvars);
  357.     for (var_info=scope->vars; var_info != NULL; var_info=var_info->next) {
  358.         int loc_info = var_info->offset << 2;
  359.         if (var_info->indirect)
  360.         loc_info |= 2;
  361.         if (var_info->argument)
  362.         loc_info |= 1;
  363.  
  364.         dump_op(fop_VECTOR2);
  365.         dump_symbol(var_info->var->symbol);
  366.         dump_integer(loc_info);
  367.     }
  368.  
  369.     if (scope->outer)
  370.         dump_vars(scope->outer);
  371.     }
  372. }
  373.  
  374. static void dump_debug_info(struct component *c)
  375. {
  376.     struct debug_info *info;
  377.     
  378.     dump_vector_header(c->ndebug_infos);
  379.     for (info = c->debug_info; info != NULL; info = info->next) {
  380.     dump_op(fop_VECTOR3);
  381.     dump_integer(info->line);
  382.     dump_integer(info->bytes);
  383.     if (info->scope)
  384.         dump_vars(info->scope);
  385.     else
  386.         dump_op(fop_NIL);
  387.     }
  388. }
  389.  
  390.  
  391. /* Method Dumping */
  392.  
  393. static void dump_component(struct component *c)
  394. {
  395.     struct constant *constant;
  396.     struct block *block;
  397.     int bytes;
  398.  
  399.     if (c->nconstants < 256 && c->bytes < (1<<16)) {
  400.     dump_op(fop_SHORT_COMPONENT);
  401.     dump_byte(c->nconstants);
  402.     dump_short(c->bytes);
  403.     }
  404.     else {
  405.     dump_op(fop_COMPONENT);
  406.     dump_int(c->nconstants);
  407.     dump_int(c->bytes);
  408.     }
  409.  
  410.     if (c->debug_name)
  411.     dump_literal(c->debug_name);
  412.     else
  413.     dump_op(fop_FALSE);
  414.  
  415.     dump_integer(c->frame_size);
  416.  
  417.     dump_debug_info(c);
  418.  
  419.     for (constant = c->constants; constant != NULL; constant = constant->next)
  420.     dump_constant(constant);
  421.  
  422.     bytes = 0;
  423.     for (block = c->blocks; block != NULL; block = block->next) {
  424.     int count = block->end - block->bytes;
  425.     dump_bytes(block->bytes, count);
  426.     bytes += count;
  427.     }
  428.     if (bytes != c->bytes)
  429.     lose("Planned on writing %d bytes, but ended up writing %d instead.",
  430.          c->bytes, bytes);
  431. }
  432.  
  433. static void dump_method(struct method *method)
  434. {
  435.     struct param_list *params = method->params;
  436.     struct keyword_param *k;
  437.     int param_info, nkeys;
  438.     int nclosure_vars;
  439.     struct closes_over *over;
  440.  
  441.     if (params->rest_param)
  442.     param_info = 1;
  443.     else
  444.     param_info = 0;
  445.     if (params->all_keys)
  446.     param_info |= 2;
  447.     if (params->allow_keys) {
  448.     nkeys = 0;
  449.     for (k = params->keyword_params; k != NULL; k = k->next)
  450.         nkeys++;
  451.     param_info = param_info | (nkeys+1)<<2;
  452.     }
  453.     
  454.     nclosure_vars = 0;
  455.     for (over = method->closes_over; over != NULL; over = over->next)
  456.     nclosure_vars++;
  457.     
  458.     if (param_info < 256 && nclosure_vars < 256) {
  459.     dump_op(fop_SHORT_METHOD);
  460.     dump_byte(param_info);
  461.     dump_byte(nclosure_vars);
  462.     }
  463.     else {
  464.     dump_op(fop_METHOD);
  465.     dump_int(param_info);
  466.     dump_int(nclosure_vars);
  467.     }
  468.  
  469.     for (k = params->keyword_params; k != NULL; k = k->next) {
  470.     struct literal_expr *def = (struct literal_expr *)k->def;
  471.     dump_symbol(k->keyword);
  472.     if (def) {
  473.         if (def->kind != expr_LITERAL)
  474.         lose("non-literal keyword default made it though expand?");
  475.         dump_literal(def->lit);
  476.     }
  477.     else
  478.         dump_op(fop_FALSE);
  479.     }
  480.  
  481.     dump_component(method->component);
  482. }
  483.  
  484. static void dump_varref(struct id *id, boolean written)
  485. {
  486.     if (id->line) {
  487.     dump_op(fop_NOTE_REFERENCE);
  488.     dump_int(id->line);
  489.     }
  490.     
  491.     if (id->internal)
  492.     if (written)
  493.         dump_op(fop_BUILTIN_WRITABLE_VALUE_CELL);
  494.     else
  495.         dump_op(fop_BUILTIN_VALUE_CELL);
  496.     else
  497.     if (written)
  498.         dump_op(fop_WRITABLE_VALUE_CELL);
  499.     else
  500.         dump_op(fop_VALUE_CELL);
  501.  
  502.     dump_symbol(id->symbol);
  503. }
  504.  
  505. static void dump_constant(struct constant *c)
  506. {
  507.     switch (c->kind) {
  508.       case constant_LITERAL:
  509.     dump_literal(c->u.literal);
  510.     break;
  511.       case constant_METHODDESC:
  512.     dump_method(c->u.method);
  513.     break;
  514.       case constant_VARREF:
  515.     dump_varref(c->u.varref.id, c->u.varref.written);
  516.     break;
  517.     }
  518. }
  519.  
  520.  
  521. /* Defconst and Defvar dumping. */
  522.  
  523. static void dump_defconst_or_var(struct param_list *params)
  524. {
  525.     int count;
  526.     struct param *p;
  527.  
  528.     count = 0;
  529.     for (p = params->required_params; p != NULL; p = p->next)
  530.     count++;
  531.     if (params->rest_param)
  532.     count++;
  533.  
  534.     dump_integer(count);
  535.     for (p = params->required_params; p != NULL; p = p->next)
  536.     dump_symbol(p->id->symbol);
  537.     if (params->rest_param)
  538.     dump_symbol(params->rest_param->symbol);
  539. }
  540.  
  541.  
  542. /* Namespace (module and library) dumping. */
  543.  
  544.  
  545. static void dump_defnamespace(struct defnamespace_constituent *c,
  546.                   boolean dump_creates)
  547. {
  548.     struct use_clause *use;
  549.  
  550.     dump_literal(c->name);
  551.     for (use = c->use_clauses; use != NULL; use = use->next) {
  552.     dump_literal(use->name);
  553.     dump_literal(use->import);
  554.     dump_literal(use->exclude);
  555.     dump_literal(use->prefix);
  556.     dump_literal(use->rename);
  557.     dump_literal(use->export);
  558.     }
  559.     dump_op(fop_FALSE);
  560.     dump_literal(c->exported_literal);
  561.     if (dump_creates)
  562.     dump_literal(c->created_literal);
  563. }
  564.  
  565.  
  566. /* Interface to the output file dumper */
  567.  
  568. void dump_setup_output(char *source, FILE *file)
  569. {
  570.     struct stat buf;
  571.     time_t tv;
  572.     int statres;
  573.  
  574.     File = file;
  575.  
  576. #if ! NO_SHARP_BANG
  577.     fprintf(File, "#!%s/mindy -x\n", BINDIR);
  578. #endif
  579.     fprintf(File, "# %s (%d.%d) of %s\n", "compilation",
  580.         file_MajorVersion, file_MinorVersion, source);
  581.     statres = stat(source, &buf);
  582.     if (statres >= 0)
  583.     fprintf(File, "# last modified on %s", ctime(&buf.st_mtime));
  584.     fprintf(File, "# produced with the %s version of mindycomp\n", Version);
  585.     time(&tv);
  586.     fprintf(File, "# at %s", ctime(&tv));
  587.  
  588.     dump_op(fop_HEADER);
  589.     dump_byte(file_MajorVersion);
  590.     dump_byte(file_MinorVersion);
  591.     dump_byte(sizeof(short));
  592.     dump_byte(sizeof(int));
  593.     dump_byte(sizeof(long));
  594.     dump_byte(sizeof(float));
  595.     dump_byte(sizeof(double));
  596.     dump_byte(sizeof(long double));
  597.     dump_short(1);
  598.     dump_int(dbc_MagicNumber);
  599.     dump_op(fop_IN_LIBRARY);
  600.     if (LibraryName)
  601.     dump_symbol(LibraryName);
  602.     else
  603.     dump_symbol(sym_DylanUser);
  604.     if (source != NULL) {
  605.     dump_op(fop_SOURCE_FILE);
  606.     if (statres >= 0)
  607.         dump_integer(buf.st_mtime);
  608.     else
  609.         dump_integer(0);
  610.     dump_string_guts(fop_SHORT_STRING, fop_STRING, source, strlen(source));
  611.     }
  612. }
  613.  
  614. void dump_top_level_form(struct component *c)
  615. {
  616.     if (!ModuleDumped) {
  617.     dump_op(fop_IN_MODULE);
  618.     dump_symbol(ModuleName);
  619.     ModuleDumped = TRUE;
  620.     }
  621.  
  622.     dump_op(fop_TOP_LEVEL_FORM);
  623.     dump_component(c);
  624. }
  625.  
  626. void dump_defmethod(struct id *name, struct component *c)
  627. {
  628.     if (!ModuleDumped) {
  629.     dump_op(fop_IN_MODULE);
  630.     dump_symbol(ModuleName);
  631.     ModuleDumped = TRUE;
  632.     }
  633.  
  634.     dump_op(fop_DEFINE_METHOD);
  635.     dump_symbol(name->symbol);
  636.     dump_component(c);
  637. }
  638.  
  639. void dump_defgeneric(struct id *name, struct component *tlf)
  640. {
  641.     if (!ModuleDumped) {
  642.     dump_op(fop_IN_MODULE);
  643.     dump_symbol(ModuleName);
  644.     ModuleDumped = TRUE;
  645.     }
  646.  
  647.     dump_op(fop_DEFINE_GENERIC);
  648.     dump_symbol(name->symbol);
  649.     dump_component(tlf);
  650. }
  651.  
  652. void dump_defclass(struct id *name, struct slot_spec *slots,
  653.            struct component *tlf1, struct component *tlf2)
  654. {
  655.     struct slot_spec *slot;
  656.  
  657.     if (!ModuleDumped) {
  658.     dump_op(fop_IN_MODULE);
  659.     dump_symbol(ModuleName);
  660.     ModuleDumped = TRUE;
  661.     }
  662.  
  663.     dump_op(fop_DEFINE_CLASS);
  664.     dump_symbol(name->symbol);
  665.     for (slot = slots; slot != NULL; slot = slot->next) {
  666.     dump_symbol(slot->getter->symbol);
  667.     if (slot->setter)
  668.         dump_symbol(slot->setter->symbol);
  669.     }
  670.     dump_op(fop_FALSE);
  671.     dump_component(tlf1);
  672.     dump_component(tlf2);
  673. }
  674.  
  675. void dump_defconst(struct param_list *params, struct component *initializer)
  676. {
  677.     if (!ModuleDumped) {
  678.     dump_op(fop_IN_MODULE);
  679.     dump_symbol(ModuleName);
  680.     ModuleDumped = TRUE;
  681.     }
  682.  
  683.     dump_op(fop_DEFINE_CONSTANT);
  684.     dump_defconst_or_var(params);
  685.     dump_component(initializer);
  686. }
  687.  
  688. void dump_defvar(struct param_list *params, struct component *initializer)
  689. {
  690.     if (!ModuleDumped) {
  691.     dump_op(fop_IN_MODULE);
  692.     dump_symbol(ModuleName);
  693.     ModuleDumped = TRUE;
  694.     }
  695.  
  696.     dump_op(fop_DEFINE_VARIABLE);
  697.     dump_defconst_or_var(params);
  698.     dump_component(initializer);
  699. }
  700.  
  701. void dump_defmodule(struct defnamespace_constituent *c)
  702. {
  703.     dump_op(fop_DEFINE_MODULE);
  704.     dump_defnamespace(c, TRUE);
  705. }
  706.  
  707. void dump_deflibrary(struct defnamespace_constituent *c)
  708. {
  709.     dump_op(fop_DEFINE_LIBRARY);
  710.     dump_defnamespace(c, FALSE);
  711. }
  712.  
  713. void dump_finalize_output(void)
  714. {
  715.     dump_op(fop_DONE);
  716. }
  717.  
  718.  
  719.  
  720. /* Stuff to dump program parses */
  721.  
  722. static void dump_body(struct body *body);
  723. static void dump_expr(struct expr *expr);
  724.  
  725. static void dump_id(struct id *id)
  726. {
  727.     dump_symbol(id->symbol);
  728.     dump_op(id->internal ? fop_TRUE : fop_FALSE);
  729.     dump_integer(id->line);
  730. }
  731.  
  732. static void dump_param_list(struct param_list *params)
  733. {
  734.     struct param *p;
  735.     int nparams = 0;
  736.  
  737.     for (p = params->required_params; p != NULL; p = p->next)
  738.     nparams++;
  739.     dump_integer(nparams);
  740.     for (p = params->required_params; p != NULL; p = p->next) {
  741.     dump_id(p->id);
  742.     if (p->type)
  743.         dump_expr(p->type);
  744.     else
  745.         dump_op(fop_FALSE);
  746.     }
  747.  
  748.     if (params->next_param)
  749.     dump_id(params->next_param);
  750.     else
  751.     dump_op(fop_FALSE);
  752.  
  753.     if (params->rest_param)
  754.     dump_id(params->rest_param);
  755.     else
  756.     dump_op(fop_FALSE);
  757.  
  758.     if (params->allow_keys) {
  759.     struct keyword_param *k;
  760.     int nkeys = 0;
  761.  
  762.     for (k = params->keyword_params; k != NULL; k = k->next)
  763.         nkeys++;
  764.     dump_integer(nkeys);
  765.  
  766.     for (k = params->keyword_params; k != NULL; k = k->next) {
  767.         dump_symbol(k->keyword);
  768.         dump_id(k->id);
  769.         if (k->type)
  770.         dump_expr(k->type);
  771.         else
  772.         dump_op(fop_FALSE);
  773.         if (k->def)
  774.         dump_expr(k->def);
  775.         else
  776.         dump_op(fop_FALSE);
  777.     }
  778.     }
  779.     else
  780.     dump_op(fop_FALSE);
  781. }
  782.  
  783. static void dump_bindings(struct bindings *bindings)
  784. {
  785.     dump_param_list(bindings->params);
  786.     dump_expr(bindings->expr);
  787. }
  788.  
  789. static void dump_rettypes(struct return_type_list *rettypes)
  790. {
  791.     struct return_type *r;
  792.     int nreq = 0;
  793.  
  794.     if (rettypes != NULL) {
  795.     for (r = rettypes->req_types; r != NULL; r = r->next)
  796.         nreq++;
  797.     dump_integer(nreq);
  798.     for (r = rettypes->req_types; r != NULL; r = r->next)
  799.         if (r->type)
  800.         dump_expr(r->type);
  801.         else
  802.         dump_op(fop_FALSE);
  803.     if (rettypes->rest_type)
  804.         dump_expr(r->type);
  805.     else
  806.         dump_op(fop_FALSE);
  807.     }
  808.     else
  809.     dump_op(fop_FALSE);
  810. }
  811.  
  812. static void dump_plist(struct plist *plist)
  813. {
  814.     if (plist) {
  815.     struct property *p;
  816.     int nprops = 0;
  817.  
  818.     for (p = plist->head; p != NULL; p = p->next)
  819.         nprops++;
  820.     dump_integer(nprops);
  821.     for (p = plist->head; p != NULL; p = p->next) {
  822.         dump_symbol(p->keyword);
  823.         dump_expr(p->expr);
  824.     }
  825.     }
  826.     else
  827.     dump_integer(0);
  828. }
  829.  
  830. static void dump_method_parse(struct method *method)
  831. {
  832.     if (method->name)
  833.     dump_id(method->name);
  834.     else
  835.     dump_op(fop_FALSE);
  836.     dump_param_list(method->params);
  837.     dump_rettypes(method->rettypes);
  838.     dump_body(method->body);
  839. }
  840.  
  841. static void dump_varref_expr(struct varref_expr *expr)
  842. {
  843.     dump_op(fop_VARREF_EXPR);
  844.     dump_id(expr->var);
  845. }
  846.  
  847. static void dump_literal_expr(struct literal_expr *expr)
  848. {
  849.     dump_op(fop_LITERAL_EXPR);
  850.     dump_literal(expr->lit);
  851. }
  852.  
  853. static void dump_call_expr(struct call_expr *expr)
  854. {
  855.     struct argument *args;
  856.     int nargs = 0;
  857.  
  858.     dump_op(fop_CALL_EXPR);
  859.     dump_expr(expr->func);
  860.     for (args = expr->args; args != NULL; args = args->next)
  861.     nargs++;
  862.     dump_integer(nargs);
  863.     for (args = expr->args; args != NULL; args = args->next)
  864.     dump_expr(args->expr);
  865. }
  866.  
  867. static void dump_method_expr(struct method_expr *expr)
  868. {
  869.     dump_op(fop_METHOD_EXPR);
  870.     dump_method_parse(expr->method);
  871. }
  872.  
  873. static void dump_dot_expr(struct dot_expr *expr)
  874. {
  875.     dump_op(fop_DOT_EXPR);
  876.     dump_expr(expr->arg);
  877.     dump_expr(expr->func);
  878. }
  879.  
  880. static void dump_body_expr(struct body_expr *expr)
  881. {
  882.     dump_op(fop_BODY_EXPR);
  883.     dump_body(expr->body);
  884. }
  885.  
  886. static void dump_block_expr(struct block_expr *expr)
  887. {
  888.     dump_op(fop_BLOCK_EXPR);
  889.     if (expr->exit_fun)
  890.     dump_id(expr->exit_fun);
  891.     else
  892.     dump_op(fop_FALSE);
  893.     dump_body(expr->body);
  894.     if (expr->inner)
  895.     lose("Dumping a block that still has exception clauses?");
  896.     if (expr->cleanup)
  897.     dump_body(expr->cleanup);
  898.     else
  899.     dump_op(fop_FALSE);
  900.     if (expr->outer)
  901.     lose("Dumping a block that still has exception clauses?");
  902. }
  903.  
  904. static void dump_case_expr(struct case_expr *expr)
  905. {
  906.     lose("case made it though expand?");
  907. }
  908.  
  909. static void dump_if_expr(struct if_expr *expr)
  910. {
  911.     dump_op(fop_IF_EXPR);
  912.     dump_expr(expr->cond);
  913.     dump_body(expr->consequent);
  914.     dump_body(expr->alternate);
  915. }
  916.  
  917. static void dump_for_expr(struct for_expr *expr)
  918. {
  919.     lose("for made it though expand?");
  920. }
  921.  
  922. static void dump_select_expr(struct select_expr *expr)
  923. {
  924.     lose("select made it though expand?");
  925. }
  926.  
  927. static void dump_varset_expr(struct varset_expr *expr)
  928. {
  929.     dump_op(fop_VARSET_EXPR);
  930.     dump_id(expr->var);
  931.     dump_expr(expr->value);
  932. }
  933.  
  934. static void dump_binop_series_expr(struct binop_series_expr *expr)
  935. {
  936.     lose("binop series made it though expand?");
  937. }
  938.  
  939. static void dump_loop_expr(struct loop_expr *expr)
  940. {
  941.     dump_op(fop_LOOP_EXPR);
  942.     dump_body(expr->body);
  943. }
  944.  
  945. static void dump_repeat_expr(struct repeat_expr *expr)
  946. {
  947.     dump_op(fop_REPEAT_EXPR);
  948. }
  949.  
  950. static void dump_error_expr(struct expr *expr)
  951. {
  952.     lose("Called dump on a parse tree with errors?");
  953. }
  954.  
  955. static void (*ExpressionDumpers[])() = {
  956.     dump_varref_expr, dump_literal_expr, dump_call_expr,
  957.     dump_method_expr, dump_dot_expr, dump_body_expr, dump_block_expr,
  958.     dump_case_expr, dump_if_expr, dump_for_expr, dump_select_expr,
  959.     dump_varset_expr, dump_binop_series_expr, dump_loop_expr,
  960.     dump_repeat_expr, dump_error_expr
  961. };
  962.  
  963. static void dump_expr(struct expr *expr)
  964. {
  965.     (*ExpressionDumpers[(int)expr->kind])(expr);
  966. }
  967.  
  968. static void dump_defconst_constituent(struct defconst_constituent *c)
  969. {
  970.     dump_op(fop_DEFINE_CONSTANT);
  971.     dump_bindings(c->bindings);
  972. }
  973.  
  974. static void dump_defvar_constituent(struct defvar_constituent *c)
  975. {
  976.     dump_op(fop_DEFINE_VARIABLE);
  977.     dump_bindings(c->bindings);
  978. }
  979.  
  980. static void dump_defmethod_constituent(struct defmethod_constituent *c)
  981. {
  982.     dump_op(fop_DEFINE_METHOD);
  983.     dump_method_parse(c->method);
  984. }
  985.  
  986. static void dump_defgeneric_constituent(struct defgeneric_constituent *c)
  987. {
  988.     dump_op(fop_DEFINE_GENERIC);
  989.     dump_id(c->name);
  990.     dump_param_list(c->params);
  991.     dump_rettypes(c->rettypes);
  992.     dump_plist(c->plist);
  993. }
  994.  
  995. static void dump_defclass_constituent(struct defclass_constituent *c)
  996. {
  997.     struct superclass *super;
  998.     struct slot_spec *slot;
  999.     struct initarg_spec *initarg;
  1000.     struct inherited_spec *inherited;
  1001.     int n;
  1002.  
  1003.     dump_op(fop_DEFINE_CLASS);
  1004.  
  1005.     n = 0;
  1006.     for (super = c->supers; super != NULL; super = super->next)
  1007.     n++;
  1008.     dump_integer(n);
  1009.     for (super = c->supers; super != NULL; super = super->next)
  1010.     dump_expr(super->expr);
  1011.     
  1012.     n = 0;
  1013.     for (slot = c->slots; slot != NULL; slot = slot->next)
  1014.     n++;
  1015.     dump_integer(n);
  1016.     for (slot = c->slots; slot != NULL; slot = slot->next) {
  1017.     switch (slot->alloc) {
  1018.       case alloc_INSTANCE:
  1019.         dump_symbol(sym_Instance);
  1020.         break;
  1021.       case alloc_CLASS:
  1022.         dump_symbol(sym_Class);
  1023.         break;
  1024.       case alloc_SUBCLASS:
  1025.         dump_symbol(sym_Subclass);
  1026.         break;
  1027.       case alloc_CONSTANT:
  1028.         dump_symbol(sym_Constant);
  1029.         break;
  1030.       case alloc_VIRTUAL:
  1031.         dump_symbol(sym_Virtual);
  1032.         break;
  1033.       default:
  1034.         lose("strange slot allocation");
  1035.     }
  1036.     if (slot->name)
  1037.         dump_id(slot->name);
  1038.     else
  1039.         dump_op(fop_FALSE);
  1040.     if (slot->type)
  1041.         dump_expr(slot->type);
  1042.     else
  1043.         dump_op(fop_FALSE);
  1044.     dump_plist(slot->plist);
  1045.     }
  1046.  
  1047.     n = 0;
  1048.     for (initarg = c->initargs; initarg != NULL; initarg = initarg->next)
  1049.     n++;
  1050.     dump_integer(n);
  1051.     for (initarg = c->initargs; initarg != NULL; initarg = initarg->next) {
  1052.     dump_symbol(initarg->keyword);
  1053.     dump_plist(initarg->plist);
  1054.     }
  1055.  
  1056.     n = 0;
  1057.     for (inherited = c->inheriteds; inherited != NULL;
  1058.      inherited = inherited->next)
  1059.     n++;
  1060.     dump_integer(n);
  1061.     for (inherited = c->inheriteds; inherited != NULL;
  1062.      inherited = inherited->next) {
  1063.     dump_id(inherited->name);
  1064.     dump_plist(inherited->plist);
  1065.     }
  1066. }
  1067.  
  1068. static void dump_expr_constituent(struct expr_constituent *c)
  1069. {
  1070.     dump_op(fop_EXPR_CONSTITUENT);
  1071.     dump_expr(c->expr);
  1072. }
  1073.  
  1074. static void dump_local_constituent(struct local_constituent *c)
  1075. {
  1076.     struct method *m;
  1077.     int nlocals = 0;
  1078.  
  1079.     dump_op(fop_LOCAL_CONSTITUENT);
  1080.     for (m = c->methods; m != NULL; m = m->next_local)
  1081.     nlocals++;
  1082.     dump_integer(nlocals);
  1083.     for (m = c->methods; m != NULL; m = m->next_local)
  1084.     dump_method_parse(m);
  1085.     dump_body(c->body);
  1086. }
  1087.  
  1088. static void dump_handler_constituent(struct handler_constituent *c)
  1089. {
  1090.     dump_op(fop_HANDLER_CONSTITUENT);
  1091.     dump_body(c->body);
  1092. }
  1093.  
  1094. static void dump_let_constituent(struct let_constituent *let)
  1095. {
  1096.     dump_op(fop_LET_CONSTITUENT);
  1097.     dump_bindings(let->bindings);
  1098.     dump_body(let->body);
  1099. }
  1100.  
  1101. static void dump_tlf_constituent(struct tlf_constituent *c)
  1102. {
  1103.     lose("top-level-form method inserted when parsing only?");
  1104. }
  1105.  
  1106. static void dump_error_constituent(struct constituent *c)
  1107. {
  1108.     lose("Called dump on a parse tree with errors?");
  1109. }
  1110.  
  1111. static void dump_defmodule_constituent(struct defnamespace_constituent *c)
  1112. {
  1113.     dump_op(fop_DEFINE_MODULE);
  1114.     dump_defnamespace(c, TRUE);
  1115. }
  1116.  
  1117. static void dump_deflibrary_constituent(struct defnamespace_constituent *c)
  1118. {
  1119.     dump_op(fop_DEFINE_LIBRARY);
  1120.     dump_defnamespace(c, FALSE);
  1121. }
  1122.  
  1123.  
  1124. static void (*DumpConstituents[])() = {
  1125.     dump_defconst_constituent, dump_defvar_constituent,
  1126.     dump_defmethod_constituent, dump_defgeneric_constituent,
  1127.     dump_defclass_constituent, dump_expr_constituent,
  1128.     dump_local_constituent, dump_handler_constituent,
  1129.     dump_let_constituent, dump_tlf_constituent,
  1130.     dump_error_constituent, dump_defmodule_constituent,
  1131.     dump_deflibrary_constituent
  1132. };
  1133.  
  1134. static void dump_body(struct body *body)
  1135. {
  1136.     struct constituent *c;
  1137.     int nconstits = 0;
  1138.  
  1139.     for (c = body->head; c != NULL; c = c->next)
  1140.     nconstits++;
  1141.     dump_integer(nconstits);
  1142.     for (c = body->head; c != NULL; c = c->next)
  1143.     (*DumpConstituents[(int)c->kind])(c);
  1144. }
  1145.  
  1146. void dump_program(struct body *body)
  1147. {
  1148.     dump_body(body);
  1149. }
  1150.